home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d23 / zipstamp.arc / ZIPSTAMP.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1989-06-22  |  3.1 KB  |  129 lines
  1. {$A-,B-,D+,E-,F-,I-,L+,N-,O-,R-,S-,V-}
  2. {$M 16384,0,655360}
  3.  
  4. program ZipList;
  5.  
  6.  
  7. uses
  8.   TpCrt,    { Turbo Power's CRT Unit - can use CRT with NO modification }
  9.   Zipper,   { Zip code from Thomas Guinther }
  10.   Engine,   { Directory engine code from Turbo Technix }
  11.   DOS;      { Standard Borland DOS unit }
  12.  
  13.  
  14. const
  15.   CompMethodStr  :array[0..5]of String=('No Compression','Shrunk','Reduced (CF=1)',
  16.                                        'Reduced (CF=2)','Reduced (CF=3)','Reduced (CF=5)');
  17.  
  18. var
  19.   LastDate       :Word;
  20.   LastTime       :Word;
  21.   Ch             : Char;
  22. type
  23.   TimeDateRec    =record
  24.                    Date           :Word;
  25.                    Time           :Word;
  26.                  end;
  27.  
  28.  
  29. var
  30.   zF             :zFile;
  31.   Zrec           :ZipDirRec;
  32.   TimeDate       :TimeDateRec;
  33.   TimeDateStamp  :LongInt absolute TimeDate;
  34.   UnPakedRec     :DateTime;
  35.   Error          :Byte;
  36.  
  37.  
  38.   Function ZeroPad(S:String):String;
  39.   begin
  40.     If Length(s) = 1 then S:='0'+S;
  41.     ZeroPad := S;
  42.   end;
  43.  
  44.   procedure GetDates(pZ:pZipDir);
  45.   begin
  46.     with pZ^,pCD^,FileInfo do
  47.     begin
  48.       if FDate>LastDate then
  49.       begin
  50.         LastDate:=FDate;
  51.         LastTime:=FTime;
  52.       end;
  53.     end;
  54.   end;
  55.  
  56.   {$F+}
  57.   procedure StampIt(Var S:SearchRec;path:PathStr);
  58.   var
  59.     Ch : Char;
  60.     Hours : String[2];
  61.     MinS  : String[2];
  62.     Secs  : String[2];
  63.   begin
  64.     LastDate:=0;
  65.     LastTime:=0;
  66.     if not OpenZip(zF,Path+S.Name)then
  67.     begin
  68.       Gotoxy(1,20);
  69.       Write('Unable to open: ',Path+S.Name);
  70.       ClrEol;
  71.       Exit;
  72.     end;
  73.     If Path = '' then
  74.     begin
  75.       GetDir(0,Path);
  76.       Path := Path +'\';
  77.     end;
  78.     Gotoxy(1,12);
  79.     Write('Processing file ',Path+S.Name);ClrEol;
  80.     Writeln;
  81.     if FindCentralDirectory(zF)<>0 then
  82.     begin
  83.       while ReadCentralDirEntry(zF, @Zrec)do
  84.       begin
  85.         GetDates(@Zrec);
  86.         FreeZipRec(@Zrec);
  87.       end;
  88.       TimeDate.Time:=LastDate;
  89.       TimeDate.Date:=LastTime;
  90.       UnpackTime(TimeDateStamp,UnPakedRec);
  91.       Str(UnpakedRec.Hour,Hours);
  92.       Str(UnpakedRec.Min,Mins);
  93.       Str(UnpakedRec.Sec,Secs);
  94.       with UnPakedRec do
  95.         Write('Latest file stamp is : ',Month,'/',Day,'/',
  96.         Year,'  ', ZeroPad(HourS),':',ZeroPad(MinS),':',ZeroPad(SecS));
  97.         ClrEol;
  98.  
  99.     end
  100.     else
  101.       WriteLn(Path+S.Name+': Unable to find ZIP directory.');
  102.     SetFTime(zF,TimeDateStamp);
  103.     Close(zF);
  104.   end;
  105.  
  106.   procedure FindAndProcessAllZips;
  107.   begin
  108.     If (ParamStr(1) = '/s') or (ParamStr(1) = '/S') then
  109.       SearchEngineAll('\','*.ZIP',AnyFile,StampIt,Error)
  110.     else
  111.       SearchEngine('*.ZIP',AnyFile,StampIt,Error);
  112.   end;
  113.  
  114.   {$F-}
  115.  
  116. begin
  117.   ClrScr;
  118.   DirectVideo:=True;
  119.   Writeln('ZipStamp - Based upon Zip Directory code by Mr. Thomas Guinther');
  120.   Writeln('By Stephen Genusa - 149 Wheeler Road - Monroe, LA 71203');
  121.   Writeln;
  122.   Writeln;
  123.   Writeln('Use the /s parameter to search the entire hard disk.');
  124.   Writeln;
  125.   Writeln('Press any key to start - this will not take very long!');
  126.   Ch := Readkey;
  127.   FindAndProcessAllZips;
  128. end.
  129.